Zaawansowana Eksploracja Danych - analiza cen złota
Tomasz Chudziak
2021-12-11
1 Wstęp
Poniższy raport przedstawia proces tworzenia modelu służącego do przewidywania cen złota. W tym celu wykorzystane zostało pięć zbiorów danych:
- cen złota w latach 1968-2021,
- kursy walut w latach 1995-2018,
- miesięcznyne wyniki S&P Composite w latach 1871-2021,
- światowe wskaźniki rozwoju w latach 1970-2020,
- ceny bitcoina w latach 2010-2021.
Głównym celem było stworzenie regresora, który przewidywałby ceny złota na podstawie danych z powyższych zbiorów. Do seleckji atrybutów wykorzystana została korelacja Pearsona. Ze zbioru kursu walut została wykorzystana historia kursu dolara australijskiego oraz dolara brunejskiego. Ze zbioru miesięcznych wyników S&P Composite wskaźnik CPI, wartość dywidend oraz prawdziwe zarobki. Ze zbioru wskaźników rozwoju światowy wskaźnik PKB.
Ostatecznie udało się stworzyć regresor o podanych wynikach:
- RMSE 26.3441912
- MAE 10.9177527
- Rsquared 0.9969315
Po badaniu istotności wykorzystanych atrybutów okazało się, że najmniejszy wpływ miał światowy wskaźnik PKB, może być to spowodowane tym, że celem zadania było obliczenie wartości złota w konkretnym dniu, natomiast wskaźnik ten był liczony dla całego roku.
2 Biblioteki
Wykorzystane biblioteki:
- readxl - wczytuje plik xlsx,
- dplyr, tidyr, lubridate, tibble, zoo - manipuluje danymi,
- ggplot2, lattice, plotly, rmarkdown - wizualizacja danych,
- DT - tworzy estetyczne tabele,
- ggcorrplot - wizualizuje graficznie korelacje,
- caret - tworzenie modelu predykcji
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(DT)
library(lattice)
library(plotly)
library(lubridate)
library(tibble)
library(rmarkdown)
library(zoo)
library(ggcorrplot)
library(caret)3 Dane
3.1 Wczytanie danych
Poniższy blok kodu wczytuje dane:
- goldPrice - ceny złota,
- currencyExchangeRates - kursy wymiany walut,
- spComposite - indeks giełdowy amerykańskich akcji firmy Standard & Poor’s,
- worldDevelopmentIndicators - światowe wskaźniki rozwoju,
setwd("D:\\studia\\ZED\\projekt\\Data pack\\")
goldPrice <- as_tibble(read.csv(file = "Gold prices.csv"))
currencyExchangeRates <- as_tibble(read.csv(file = "CurrencyExchangeRates.csv"))
spComposite <- as_tibble(read.csv(file = "S&P Composite.csv"))
worldDevelopmentIndicators <- as_tibble(read_excel("World_Development_Indicators.xlsx"))Poniższy blok kodu wczytuje dane odnośnie bitcoina:
- BCHAIN_metadata - dane dotyczące wczytanych danych,
- BCHAIN-MKPRU - ceny bitcoina
setwd("D:\\studia\\ZED\\projekt\\Data pack\\Bitcoin")
bchain_metadata <- read.csv(file = "BCHAIN_metadata.csv")
bchain_mkpru <- read.csv(file = "BCHAIN-MKPRU.csv")3.2 Ceny złota
Podsumowanie surowych danych.
summary(goldPrice)## Date USD..AM. USD..PM. GBP..AM.
## Length:13585 Min. : 34.77 Min. : 34.75 Min. : 14.48
## Class :character 1st Qu.: 280.50 1st Qu.: 281.50 1st Qu.: 177.71
## Mode :character Median : 383.32 Median : 383.50 Median : 234.51
## Mean : 575.20 Mean : 576.62 Mean : 370.84
## 3rd Qu.: 841.94 3rd Qu.: 851.50 3rd Qu.: 454.32
## Max. :2061.50 Max. :2067.15 Max. :1574.37
## NA's :1 NA's :143 NA's :11
## GBP..PM. EURO..AM. EURO..PM.
## Min. : 14.48 Min. : 237.3 Min. : 236.7
## 1st Qu.: 178.23 1st Qu.: 335.3 1st Qu.: 335.2
## Median : 234.96 Median : 892.6 Median : 896.1
## Mean : 371.81 Mean : 797.3 Mean : 797.2
## 3rd Qu.: 456.43 3rd Qu.:1114.1 3rd Qu.:1114.9
## Max. :1569.59 Max. :1743.8 Max. :1743.4
## NA's :154 NA's :7837 NA's :7880Do dalszej analizy użyto cen złota podanej w dolarach, ponieważ miała ona najmniej nieustalonych wartości. Dane zostały zmodyfikowane, aby osiągnąć pojedynczą cenę złota na konkretny dzień. Wymagało to obliczania średniej z dwóch kolumn (ceny AM oraz PM, w przypadku braku jednej z nich brana była dostępna wartość).
gp<- goldPrice %>%
mutate(Date=as.Date(Date,format="%Y-%m-%d")) %>%
mutate(usd=
ifelse(is.na(USD..AM.), USD..PM.,
ifelse(is.na(USD..PM.), USD..AM.,
round((USD..AM.+USD..PM.)/2.0,digits=2)
)
),
gbp=
ifelse(is.na(GBP..AM.), GBP..PM.,
ifelse(is.na(GBP..PM.), GBP..AM.,
round((GBP..AM.+GBP..PM.)/2.0,digits=2)
)
),
euro=
ifelse(is.na(EURO..AM.), EURO..PM.,
ifelse(is.na(EURO..PM.), EURO..AM.,
round((EURO..AM.+EURO..PM.)/2.0,digits=2)
)
)
) %>%
rename(g_date=Date, g_usd=usd, g_gbp=gbp,g_euro=euro) %>%
select(g_date,g_usd,g_gbp,g_euro)
summary(gp)## g_date g_usd g_gbp g_euro
## Min. :1968-01-02 Min. : 34.76 Min. : 14.48 Min. : 237.0
## 1st Qu.:1981-06-10 1st Qu.: 280.28 1st Qu.: 177.71 1st Qu.: 335.2
## Median :1994-11-14 Median : 383.38 Median : 234.51 Median : 894.7
## Mean :1994-11-16 Mean : 575.07 Mean : 370.78 Mean : 797.3
## 3rd Qu.:2008-04-23 3rd Qu.: 841.00 3rd Qu.: 454.80 3rd Qu.:1114.7
## Max. :2021-09-29 Max. :2058.15 Max. :1566.94 Max. :1736.2
## NA's :11 NA's :7837gg<- ggplot(data=gp, aes(g_date)) +
geom_line(aes(y = g_usd, colour = "g_usd")) +
geom_line(aes(y = g_euro, colour = "g_euro")) +
geom_line(aes(y = g_gbp, colour = "g_gbp"))
ggplotly(gg)Powyższy wykres ilustruje zmiany cen złota w latach 1968-2021. Można na nim zauważyć, że ceny złota w różnych walutach zachowują się podobnie. Jedyna waluta, która ma znacząco krótszy czas pomiaru to euro. Pierwszy pomiar cen odnotowano w 05/01/1999r. czyli cztery dni od oficjalnego wejścia do obiegu owej waluty.
3.3 Kursy walut
Poniżej znajduje się krótkie podsumowanie wczytanych kursów walut.
colnames(currencyExchangeRates)## [1] "Date" "Algerian.Dinar"
## [3] "Australian.Dollar" "Bahrain.Dinar"
## [5] "Bolivar.Fuerte" "Botswana.Pula"
## [7] "Brazilian.Real" "Brunei.Dollar"
## [9] "Canadian.Dollar" "Chilean.Peso"
## [11] "Chinese.Yuan" "Colombian.Peso"
## [13] "Czech.Koruna" "Danish.Krone"
## [15] "Euro" "Hungarian.Forint"
## [17] "Icelandic.Krona" "Indian.Rupee"
## [19] "Indonesian.Rupiah" "Iranian.Rial"
## [21] "Israeli.New.Sheqel" "Japanese.Yen"
## [23] "Kazakhstani.Tenge" "Korean.Won"
## [25] "Kuwaiti.Dinar" "Libyan.Dinar"
## [27] "Malaysian.Ringgit" "Mauritian.Rupee"
## [29] "Mexican.Peso" "Nepalese.Rupee"
## [31] "New.Zealand.Dollar" "Norwegian.Krone"
## [33] "Nuevo.Sol" "Pakistani.Rupee"
## [35] "Peso.Uruguayo" "Philippine.Peso"
## [37] "Polish.Zloty" "Qatar.Riyal"
## [39] "Rial.Omani" "Russian.Ruble"
## [41] "Saudi.Arabian.Riyal" "Singapore.Dollar"
## [43] "South.African.Rand" "Sri.Lanka.Rupee"
## [45] "Swedish.Krona" "Swiss.Franc"
## [47] "Thai.Baht" "Trinidad.And.Tobago.Dollar"
## [49] "Tunisian.Dinar" "U.A.E..Dirham"
## [51] "U.K..Pound.Sterling" "U.S..Dollar"currencyExchangeRates<-currencyExchangeRates%>% mutate(Date=as.Date(Date,format="%Y-%m-%d"))
currencyRowNumber<-nrow(currencyExchangeRates)
summary(currencyExchangeRates)## Date Algerian.Dinar Australian.Dollar Bahrain.Dinar
## Min. :1995-01-02 Min. : 71.29 Min. :0.4833 Min. :0.376
## 1st Qu.:2000-10-05 1st Qu.: 77.50 1st Qu.:0.6654 1st Qu.:0.376
## Median :2006-07-06 Median : 81.28 Median :0.7595 Median :0.376
## Mean :2006-07-27 Mean : 90.59 Mean :0.7683 Mean :0.376
## 3rd Qu.:2012-05-07 3rd Qu.:108.88 3rd Qu.:0.8689 3rd Qu.:0.376
## Max. :2018-05-02 Max. :115.58 Max. :1.1055 Max. :0.376
## NA's :4112 NA's :263 NA's :69
## Bolivar.Fuerte Botswana.Pula Brazilian.Real Brunei.Dollar
## Min. : 2.14 Min. :0.0855 Min. :0.832 Min. :1.000
## 1st Qu.: 2.59 1st Qu.:0.1197 1st Qu.:1.709 1st Qu.:1.348
## Median : 6.28 Median :0.1528 Median :2.048 Median :1.468
## Mean : 835.09 Mean :0.1965 Mean :2.161 Mean :1.508
## 3rd Qu.: 6.28 3rd Qu.:0.1844 3rd Qu.:2.794 3rd Qu.:1.698
## Max. :68827.50 Max. :4.8414 Max. :4.195 Max. :1.851
## NA's :3664 NA's :1275 NA's :539 NA's :1246
## Canadian.Dollar Chilean.Peso Chinese.Yuan Colombian.Peso
## Min. :0.917 Min. :377.5 Min. :6.093 Min. : 833.2
## 1st Qu.:1.086 1st Qu.:503.5 1st Qu.:6.495 1st Qu.:1786.0
## Median :1.297 Median :538.6 Median :6.989 Median :2017.6
## Mean :1.268 Mean :561.8 Mean :7.316 Mean :2073.1
## 3rd Qu.:1.409 3rd Qu.:619.8 3rd Qu.:8.277 3rd Qu.:2482.9
## Max. :1.613 Max. :758.2 Max. :8.746 Max. :3434.9
## NA's :356 NA's :1220 NA's :1316 NA's :582
## Czech.Koruna Danish.Krone Euro Hungarian.Forint
## Min. :14.45 Min. :4.665 Min. :0.8252 Min. :144.1
## 1st Qu.:19.35 1st Qu.:5.612 1st Qu.:1.0889 1st Qu.:202.7
## Median :21.88 Median :6.051 Median :1.2295 Median :224.3
## Mean :22.95 Mean :6.281 Mean :1.2076 Mean :231.1
## 3rd Qu.:24.94 3rd Qu.:6.805 3rd Qu.:1.3338 3rd Qu.:267.6
## Max. :40.29 Max. :9.006 Max. :1.5990 Max. :318.7
## NA's :1850 NA's :251 NA's :1070 NA's :1415
## Icelandic.Krona Indian.Rupee Indonesian.Rupiah Iranian.Rial
## Min. : 54.72 Min. :31.37 Min. : 2201 Min. : 1699
## 1st Qu.: 70.28 1st Qu.:42.82 1st Qu.: 8855 1st Qu.: 1755
## Median : 83.48 Median :45.92 Median : 9260 Median : 8992
## Mean : 92.46 Mean :48.02 Mean : 9144 Mean :10718
## 3rd Qu.:117.15 3rd Qu.:52.33 3rd Qu.:11380 3rd Qu.:11180
## Max. :147.98 Max. :68.78 Max. :14850 Max. :42000
## NA's :354 NA's :429 NA's :1492 NA's :1312
## Israeli.New.Sheqel Japanese.Yen Kazakhstani.Tenge Korean.Won
## Min. :3.230 Min. : 75.86 Min. :117.2 Min. : 756
## 1st Qu.:3.676 1st Qu.:100.70 1st Qu.:145.4 1st Qu.:1013
## Median :3.882 Median :109.39 Median :150.3 Median :1122
## Mean :4.003 Mean :107.97 Mean :185.6 Mean :1100
## 3rd Qu.:4.370 3rd Qu.:118.38 3rd Qu.:185.7 3rd Qu.:1186
## Max. :4.994 Max. :147.00 Max. :383.9 Max. :1965
## NA's :1939 NA's :316 NA's :3051 NA's :601
## Kuwaiti.Dinar Libyan.Dinar Malaysian.Ringgit Mauritian.Rupee
## Min. :0.2646 Min. :0.525 Min. :2.436 Min. :25.15
## 1st Qu.:0.2854 1st Qu.:0.662 1st Qu.:3.188 1st Qu.:29.12
## Median :0.2947 Median :1.932 Median :3.676 Median :30.67
## Mean :0.2936 Mean :1.510 Mean :3.508 Mean :31.03
## 3rd Qu.:0.3027 3rd Qu.:1.932 3rd Qu.:3.800 3rd Qu.:32.89
## Max. :0.3089 Max. :1.932 Max. :4.725 Max. :36.50
## NA's :1054 NA's :123 NA's :301 NA's :2460
## Mexican.Peso Nepalese.Rupee New.Zealand.Dollar Norwegian.Krone
## Min. : 5.915 Min. : 49.88 Min. :0.3927 Min. :4.959
## 1st Qu.:10.953 1st Qu.: 68.33 1st Qu.:0.5813 1st Qu.:6.104
## Median :12.680 Median : 74.04 Median :0.6844 Median :6.709
## Mean :13.116 Mean : 77.37 Mean :0.6606 Mean :6.965
## 3rd Qu.:13.668 3rd Qu.: 86.80 3rd Qu.:0.7364 3rd Qu.:7.806
## Max. :21.908 Max. :109.98 Max. :0.8822 Max. :9.606
## NA's :2266 NA's :479 NA's :310 NA's :291
## Nuevo.Sol Pakistani.Rupee Peso.Uruguayo Philippine.Peso
## Min. :2.539 Min. : 30.88 Min. : 9.32 Min. :24.55
## 1st Qu.:2.755 1st Qu.: 51.79 1st Qu.:20.07 1st Qu.:43.18
## Median :2.819 Median : 60.75 Median :22.94 Median :44.40
## Mean :2.960 Mean : 70.24 Mean :24.11 Mean :45.01
## 3rd Qu.:3.243 3rd Qu.: 94.29 3rd Qu.:28.44 3rd Qu.:47.10
## Max. :3.522 Max. :115.70 Max. :32.53 Max. :52.35
## NA's :4297 NA's :488 NA's :4287 NA's :4198
## Polish.Zloty Qatar.Riyal Rial.Omani Russian.Ruble
## Min. :2.022 Min. :3.64 Min. :0.3845 Min. :23.13
## 1st Qu.:3.033 1st Qu.:3.64 1st Qu.:0.3845 1st Qu.:28.27
## Median :3.290 Median :3.64 Median :0.3845 Median :30.54
## Mean :3.365 Mean :3.64 Mean :0.3845 Mean :36.91
## 3rd Qu.:3.822 3rd Qu.:3.64 3rd Qu.:0.3845 3rd Qu.:36.20
## Max. :4.500 Max. :3.64 Max. :0.3845 Max. :83.59
## NA's :1765 NA's :47 NA's :56 NA's :2435
## Saudi.Arabian.Riyal Singapore.Dollar South.African.Rand Sri.Lanka.Rupee
## Min. :3.745 Min. :1.201 Min. : 3.530 Min. : 49.57
## 1st Qu.:3.745 1st Qu.:1.361 1st Qu.: 6.213 1st Qu.: 77.54
## Median :3.750 Median :1.444 Median : 7.480 Median :103.99
## Mean :3.749 Mean :1.503 Mean : 8.113 Mean :102.19
## 3rd Qu.:3.750 3rd Qu.:1.687 3rd Qu.: 9.995 3rd Qu.:126.29
## Max. :3.750 Max. :1.851 Max. :16.771 Max. :157.65
## NA's :46 NA's :259 NA's :535 NA's :509
## Swedish.Krona Swiss.Franc Thai.Baht Trinidad.And.Tobago.Dollar
## Min. : 5.843 Min. :0.7253 Min. :24.44 Min. :5.839
## 1st Qu.: 6.838 1st Qu.:0.9777 1st Qu.:31.50 1st Qu.:6.260
## Median : 7.618 Median :1.1878 Median :34.65 Median :6.282
## Mean : 7.741 Mean :1.2090 Mean :35.14 Mean :6.310
## 3rd Qu.: 8.384 3rd Qu.:1.3903 3rd Qu.:39.45 3rd Qu.:6.382
## Max. :10.995 Max. :1.8228 Max. :56.06 Max. :6.789
## NA's :349 NA's :239 NA's :565 NA's :657
## Tunisian.Dinar U.A.E..Dirham U.K..Pound.Sterling U.S..Dollar
## Min. :1.342 Min. :3.671 Min. :1.213 Min. :1
## 1st Qu.:1.566 1st Qu.:3.672 1st Qu.:1.519 1st Qu.:1
## Median :1.723 Median :3.672 Median :1.599 Median :1
## Mean :1.850 Mean :3.672 Mean :1.615 Mean :1
## 3rd Qu.:2.157 3rd Qu.:3.672 3rd Qu.:1.676 3rd Qu.:1
## Max. :2.509 Max. :3.675 Max. :2.102 Max. :1
## NA's :4258 NA's :71 NA's :122Poniższa komórka odpowiedzialna jest za rozpłaszenie danych w celu ułatwienia operowania na danych.
cer <- currencyExchangeRates %>%
gather(key="currency", value="value", 2:52) %>%
filter(!is.na(value))
summary(cer)## Date currency value
## Min. :1995-01-02 Length:243689 Min. : 0.09
## 1st Qu.:2002-03-01 Class :character 1st Qu.: 1.44
## Median :2008-01-10 Mode :character Median : 5.65
## Mean :2007-08-01 Mean : 485.89
## 3rd Qu.:2013-04-12 3rd Qu.: 57.11
## Max. :2018-05-02 Max. :68827.50Zbiór kursów walut zawierał 5978 pomiarów pomiędzy 1995 a 2018 rokiem. Dotyczył 51 różnych walut. Niestety prawie żadna nie była pozbawiona wartości nieznanych. Dane wymagały zmiany charakteru obserwacji. Poprzednio były to pomiary wszystkich walut w danym dniu, zmieniono to na pomiar jednej waluty w konkretnym dniu. Brakujące wartości zostały usunięte.
3.4 Indeks giełdowy S&P
Poniższy kod prezentuje podsumowanie surowych danych. Można zauważyć, że jest w nich niewielka ilość brakujących wartości. W związku, z czym uzupełniono je danymi z wartościami z pomiaru poprzedniego dnia w przypadku i ich braku z dnia następnego. Nie usuwano wierszy, ponieważ brakujących wartości nie było dużo, a najbliższa wartość może oddawać najbardziej zbliżony stan.
spComposite <- spComposite %>%
mutate(Year=as.Date(Year,format="%Y-%m-%d")) %>%
arrange(Year)
summary(spComposite)## Year S.P.Composite Dividend Earnings
## Min. :1871-01-31 Min. : 2.730 Min. : 0.1800 Min. : 0.1600
## 1st Qu.:1908-10-07 1st Qu.: 7.902 1st Qu.: 0.4202 1st Qu.: 0.5608
## Median :1946-06-15 Median : 17.370 Median : 0.8717 Median : 1.4625
## Mean :1946-06-15 Mean : 327.968 Mean : 6.7321 Mean : 15.3714
## 3rd Qu.:1984-02-21 3rd Qu.: 164.400 3rd Qu.: 7.0525 3rd Qu.: 14.7258
## Max. :2021-10-31 Max. :4493.280 Max. :59.6800 Max. :158.7400
## NA's :4 NA's :4
## CPI Long.Interest.Rate Real.Price Real.Dividend
## Min. : 6.28 Min. : 0.620 Min. : 73.9 Min. : 5.445
## 1st Qu.: 10.20 1st Qu.: 3.171 1st Qu.: 186.6 1st Qu.: 9.417
## Median : 20.35 Median : 3.815 Median : 283.3 Median :14.411
## Mean : 62.39 Mean : 4.504 Mean : 622.0 Mean :17.498
## 3rd Qu.:102.28 3rd Qu.: 5.139 3rd Qu.: 707.0 3rd Qu.:22.301
## Max. :273.98 Max. :15.320 Max. :4477.2 Max. :63.511
## NA's :4
## Real.Earnings Cyclically.Adjusted.PE.Ratio
## Min. : 4.576 Min. : 4.784
## 1st Qu.: 14.063 1st Qu.:11.898
## Median : 23.524 Median :16.381
## Mean : 34.907 Mean :17.215
## 3rd Qu.: 43.768 3rd Qu.:20.913
## Max. :159.504 Max. :44.198
## NA's :4 NA's :120head(spComposite)## # A tibble: 6 x 10
## Year S.P.Composite Dividend Earnings CPI Long.Interest.Rate Real.Price
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1871-01-31 4.44 0.26 0.4 12.5 5.32 97.3
## 2 1871-02-28 4.5 0.26 0.4 12.8 5.32 95.6
## 3 1871-03-31 4.61 0.26 0.4 13.0 5.33 96.6
## 4 1871-04-30 4.74 0.26 0.4 12.6 5.33 103.
## 5 1871-05-31 4.86 0.26 0.4 12.3 5.33 108.
## 6 1871-06-30 4.82 0.26 0.4 12.1 5.34 109.
## # ... with 3 more variables: Real.Dividend <dbl>, Real.Earnings <dbl>,
## # Cyclically.Adjusted.PE.Ratio <dbl>count(spComposite)## # A tibble: 1 x 1
## n
## <int>
## 1 1810spComposite <- spComposite %>% fill(names(.),.direction="updown")
summary(spComposite)## Year S.P.Composite Dividend Earnings
## Min. :1871-01-31 Min. : 2.730 Min. : 0.1800 Min. : 0.1600
## 1st Qu.:1908-10-07 1st Qu.: 7.902 1st Qu.: 0.4210 1st Qu.: 0.5637
## Median :1946-06-15 Median : 17.370 Median : 0.8833 Median : 1.4760
## Mean :1946-06-15 Mean : 327.968 Mean : 6.8451 Mean : 15.6882
## 3rd Qu.:1984-02-21 3rd Qu.: 164.400 3rd Qu.: 7.1425 3rd Qu.: 14.7525
## Max. :2021-10-31 Max. :4493.280 Max. :59.6800 Max. :158.7400
## CPI Long.Interest.Rate Real.Price Real.Dividend
## Min. : 6.28 Min. : 0.620 Min. : 73.9 Min. : 5.445
## 1st Qu.: 10.20 1st Qu.: 3.171 1st Qu.: 186.6 1st Qu.: 9.423
## Median : 20.35 Median : 3.815 Median : 283.3 Median :14.418
## Mean : 62.39 Mean : 4.504 Mean : 622.0 Mean :17.588
## 3rd Qu.:102.28 3rd Qu.: 5.139 3rd Qu.: 707.0 3rd Qu.:22.363
## Max. :273.98 Max. :15.320 Max. :4477.2 Max. :63.511
## Real.Earnings Cyclically.Adjusted.PE.Ratio
## Min. : 4.576 Min. : 4.784
## 1st Qu.: 14.074 1st Qu.:12.227
## Median : 23.546 Median :16.871
## Mean : 35.182 Mean :17.298
## 3rd Qu.: 43.819 3rd Qu.:20.478
## Max. :159.504 Max. :44.198spComposite <- spComposite%>%
mutate(month = format(Year, "%m"), year = format(Year, "%Y"))%>%
select(-c('Year'))
head(spComposite)## # A tibble: 6 x 11
## S.P.Composite Dividend Earnings CPI Long.Interest.Rate Real.Price
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4.44 0.26 0.4 12.5 5.32 97.3
## 2 4.5 0.26 0.4 12.8 5.32 95.6
## 3 4.61 0.26 0.4 13.0 5.33 96.6
## 4 4.74 0.26 0.4 12.6 5.33 103.
## 5 4.86 0.26 0.4 12.3 5.33 108.
## 6 4.82 0.26 0.4 12.1 5.34 109.
## # ... with 5 more variables: Real.Dividend <dbl>, Real.Earnings <dbl>,
## # Cyclically.Adjusted.PE.Ratio <dbl>, month <chr>, year <chr>3.5 Światowe wskaźniki rozwoju
Poniżej znajduje się podsumowanie danych dotyczących światowych wskaźników rozwoju. Analiza ich wymagała zmiany struktury danych. Został stworzony dataframe, w którym pojedyncza obserwacja dotyczy jednego wskaźnika w danym roku i miejscu. Nie uzupełniano brakujących wartości w danych, ponieważ mnogość i różnorodność wskaźników nie pozwala, by zrobić to w sposób uniwersalny.
colnames(worldDevelopmentIndicators)## [1] "Country Name" "Country Code" "Series Name" "Series Code"
## [5] "1970 [YR1970]" "1971 [YR1971]" "1972 [YR1972]" "1973 [YR1973]"
## [9] "1974 [YR1974]" "1975 [YR1975]" "1976 [YR1976]" "1977 [YR1977]"
## [13] "1978 [YR1978]" "1979 [YR1979]" "1980 [YR1980]" "1981 [YR1981]"
## [17] "1982 [YR1982]" "1983 [YR1983]" "1984 [YR1984]" "1985 [YR1985]"
## [21] "1986 [YR1986]" "1987 [YR1987]" "1988 [YR1988]" "1989 [YR1989]"
## [25] "1990 [YR1990]" "1991 [YR1991]" "1992 [YR1992]" "1993 [YR1993]"
## [29] "1994 [YR1994]" "1995 [YR1995]" "1996 [YR1996]" "1997 [YR1997]"
## [33] "1998 [YR1998]" "1999 [YR1999]" "2000 [YR2000]" "2001 [YR2001]"
## [37] "2002 [YR2002]" "2003 [YR2003]" "2004 [YR2004]" "2005 [YR2005]"
## [41] "2006 [YR2006]" "2007 [YR2007]" "2008 [YR2008]" "2009 [YR2009]"
## [45] "2010 [YR2010]" "2011 [YR2011]" "2012 [YR2012]" "2013 [YR2013]"
## [49] "2014 [YR2014]" "2015 [YR2015]" "2016 [YR2016]" "2017 [YR2017]"
## [53] "2018 [YR2018]" "2019 [YR2019]" "2020 [YR2020]"wdi <- gather(worldDevelopmentIndicators,key="year", value="developmentIndicators", 5:55) %>%
mutate(year = substr(year,1,4)) %>%
filter(developmentIndicators!="..") %>%
mutate_at("developmentIndicators", as.numeric) %>%
mutate_at("year", as.numeric) %>%
rename(countryCode="Country Code") %>%
rename(indicator="Series Code") %>%
rename(seriesName="Series Name")
wdi_tmp <-wdi %>% filter(countryCode %in% c("DEU","USA","GBR","JPN","RUS","IDN","POL","WLD","CHN"))
summary(wdi_tmp)## Country Name countryCode seriesName indicator
## Length:59534 Length:59534 Length:59534 Length:59534
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## year developmentIndicators
## Min. :1970 Min. :-4.813e+14
## 1st Qu.:1987 1st Qu.: 8.000e+00
## Median :2000 Median : 4.100e+01
## Mean :1998 Mean : 2.806e+12
## 3rd Qu.:2010 3rd Qu.: 4.643e+05
## Max. :2020 Max. : 7.614e+15z <- translate%>%select("Indicator Name")
paged_table(z, options = list(cols.print = 10,cols.min.print=1))3.6 Bitcoin
W tej sekcji wczytano dane dotyczące bitcoina. Zbiór nie zawierał pustych wartości. Wartym odnotowania jest fakt, że zanotowane ceny w pewnych momentach wynoszą 0 dolarów.
bchain_metadata %>%
filter(code %in% c("MKPRU")) %>%
select(code, name)## code name
## 1 MKPRU Bitcoin Market Price USDsummary(bchain_mkpru)## Date Value
## Length:4661 Min. : 0.0
## Class :character 1st Qu.: 7.2
## Mode :character Median : 431.9
## Mean : 5141.2
## 3rd Qu.: 6499.1
## Max. :63554.4bchain_mkpru<- bchain_mkpru %>%
mutate(Date=as.Date(Date,format="%Y-%m-%d"))%>%
filter(Value!=0)
gg <- ggplot(data=bchain_mkpru, aes(x=Date,y=Value)) + geom_line()
ggplotly(gg)4 Badanie powiązań
4.1 Ceny złota a cena bitcoina
W tym rozdziale badana będzie korelacja między cenami złota i kryptowaluty. Na poniższym wykresie można zobaczyć zależność ceny drogocennego metalu oraz Bitcoina. Jeżeli wartości byłyby w silnej korelacji, punkty na wykresie znajdowałyby się na jednej lub drugiej przekątnej wykresu. Można zobaczyć, że dopiero od 2017 roku warto badać tę zależność. Niestety korelacja w tych latach nie jest znacząca, najwyższą przypada na rok 2019 i wynosi około 0,7. W pozostałych latach ciężko odnaleźć zależność.
df <- bchain_mkpru %>% left_join(gp,c("Date"="g_date")) %>%
select(Date, Value, g_usd)%>%
filter(!is.na(Value) & !is.na(g_usd))
df2 <- df%>%
mutate(month = format(Date, "%m"), year = format(Date, "%Y")) %>%
group_by(month, year) %>%
summarise_at(c("g_usd","Value"),mean, na.rm = TRUE) %>%
rename(avgGold=g_usd,avgBit=Value)%>%
filter(avgGold!=0 & avgBit!=0)%>%
mutate(date = make_date(year=year, month=month))
gg <- ggplot(df2, aes(x=avgGold, y=avgBit,frame=year))+ geom_point()
ggplotly(gg)coeff <- 40
goldColor <-"green"
bitcoinColor<-"red"
ggplot(df, aes(x=Date))+
geom_line(aes(y=g_usd), color=goldColor) +
geom_line(aes(y=Value/coeff), color=bitcoinColor) +
scale_y_continuous(
name = "cena złota",
sec.axis = sec_axis( trans=~.*coeff,name="cena bitcoina")
) +
theme(
axis.title.y = element_text(color = goldColor, size=13),
axis.title.y.right = element_text(color = bitcoinColor, size=13)
)+
xlim(as.Date("2017-01-01",format="%Y-%m-%d"),as.Date("2021-09-29",format="%Y-%m-%d"))
df1 <- gp %>% select(g_usd,g_date) %>% rename(Date=g_date)
df2 <- df1%>% inner_join(bchain_mkpru)%>%
group_by(year =year(Date)) %>%
summarize(corel=cor(g_usd,Value))
ggplot(data=df2, aes(x=as.character(year), y=corel)) +
xlab("year")+
ylab("correlation")+
geom_bar(stat="identity", width=0.2)
4.2 Cena złota a waluty światowe
W tej sekcji badano korelację ceny złota pomiędzy kursami walut. Poniżej znajduje się tabelka z wynikami wszystkich walut. Warto zauważyć, że nie można było wyznaczyć korelacji z walutami: Bahrain.Dinar, Qatar.Riyal, Rial.Omani oraz U.S..Dollar. Jest to spowodowane tym, że ich wartość każdego pomiaru jest jednakowa.
gp_tmp <- gp %>% select(g_date, g_usd) %>% rename(Date=g_date, Value=g_usd)
currency <- unlist(unique(cer[c("currency")]))
experiment <- data.frame(indicator=c(),corelation=c())
for(i in currency){
tmp <- cer%>%filter(currency==i)%>%
inner_join(gp_tmp)%>%drop_na(value,Value)
corelation <- cor(tmp[c("value")],tmp[c("Value")])
tmp<-data.frame(i,corelation)
colnames(tmp)<-c("currency","corelation")
rownames(tmp) <- NULL
experiment<- rbind(experiment,tmp)
}
e<-experiment %>% arrange(desc(corelation))
prettyTable(e)4.3 Cena złota a wskaźniki światowe
W tym eksperymencie badana była korelacja między cenami złota oraz wskaźnikami światowymi. Wymagało to obliczenia średniej ceny złota dla poszczególnych lat ponieważ wskaźniki rejestrowane były dla poszczególnych lat. Postanowiono również nie skupiać się na konkretnym kraju tylko na całości pomiarów. W praktyce oznaczało to wykorzystanie danych globalnych dla całego świata.
gpTmp <-gp %>%
mutate(year = format(g_date, "%Y")) %>%
group_by(year) %>%
summarise_at(vars(g_usd),list(avg = mean))%>%
select(year,avg)%>%
mutate_at("year", as.numeric)
wdiTmp <- wdi %>%
filter(countryCode =="WLD")%>%
select(year,developmentIndicators, seriesName ,indicator)
factor<- unlist(unique(wdiTmp[c("indicator")]))
experiment <- data.frame(indicator=c(),corelation=c())
for(i in factor){
wdiInd <- wdiTmp%>% filter(indicator ==i) %>%
inner_join(gpTmp,by="year")
corelation <- cor(wdiInd[c("developmentIndicators")],wdiInd[c("avg")])
tmp<-data.frame(i,corelation)
colnames(tmp)<-c("indicator","corelation")
rownames(tmp) <- NULL
experiment<- rbind(experiment,tmp)
}result1_experiment <- experiment %>% filter(corelation>0.9)
result1_experiment$description<-mapply(translateIndicator, result1_experiment$indicator)
prettyTable(result1_experiment %>% select(description, corelation))Powyższa tabela prezentuje 19 różnych wskaźników, które mają wysoki (powyżej 0.9) współczynnik korelacji z ceną złota.
result2_experiment <- experiment %>% filter(corelation< (-0.9))
result2_experiment$description<-mapply(translateIndicator, result2_experiment$indicator)
prettyTable(result2_experiment %>% select(description, corelation))Powyższa tabela prezentuje 11 różnych wskaźników, które mają wysoki (poniżej -0.9) współczynnik korelacji z ceną złota.
4.4 Ceny złota a ceny akcji
Poniższa tabela prezentuje zależności pomiędzy cenami złota oraz cenami spółki.
df1 <- gp %>%
select(g_date,g_usd) %>%
mutate(month = format(g_date, "%m"), year = format(g_date, "%Y"))%>%
group_by(month, year) %>%
mutate(g_usd = na.aggregate(g_usd, FUN = mean,na.rm=TRUE))%>%
mutate(Year = make_date(month=month,year=year))%>%
select(Year,g_usd)
df2 <- spComposite %>%
mutate(Year = make_date(month=month,year=year))
df3 <- df2 %>%
inner_join(df1)%>%
mutate(month = format(Year, "%m"), year = format(Year, "%Y"))
x<-cor(x=df3$g_usd, y=df3[!names(df3) %in% c("Year","g_usd","month","year")], use = "complete.obs" )
x <- as.data.frame(t(x))%>% rename(corelation=V1) %>% arrange(desc(corelation))
x<-rownames_to_column(x, "NAME")
prettyTable(x)4.5 Cena bitcoina oraz akcje spółki
Poniższa tabela prezentuje zależności pomiędzy cenami bitcoina oraz cenami spółki.
df1 <- bchain_mkpru %>%
mutate(month = format(Date, "%m"), year = format(Date, "%Y"))%>%
group_by(month, year) %>%
mutate(Value = na.aggregate(Value, FUN = mean,na.rm=TRUE))%>%
mutate(Year = make_date(month=month,year=year))%>%
select(Year,Value)%>%select(-c("month","year"))
df2 <- spComposite %>% mutate(Year = make_date(month=month,year=year))%>%select(-c("month","year"))
df3 <- df2 %>% inner_join(df1)%>%select(-c("month","year"))
x <- cor(x=df3$Value, y=df3[!names(df3) %in% c("Year","Value")], use = "complete.obs" )
x <- as.data.frame(t(x))%>% rename(corelation=V1) %>% arrange(desc(corelation))
x<-rownames_to_column(x, "NAME")
prettyTable(x)4.6 Cena bitcoina oraz inne waluty
Poniższa tabela prezentuje zależności pomiędzy cenami bitcoina oraz kursami walut.
bp <- bchain_mkpru
currency <- unlist(unique(cer[c("currency")]))
experiment <- data.frame(indicator=c(),corelation=c())
for(i in currency){
tmp <- cer%>%filter(currency==i)%>%
inner_join(bp)%>%drop_na(value,Value)
corelation <- cor(tmp[c("value")],tmp[c("Value")])
tmp<-data.frame(i,corelation)
colnames(tmp)<-c("currency","corelation")
rownames(tmp) <- NULL
experiment<- rbind(experiment,tmp)
}
e<-experiment %>% arrange(desc(corelation))
prettyTable(e)4.7 Cena bitcoina a wskaźniki światowe
Poniższa tabela prezentuje zależności pomiędzy cenami bitcoina oraz wskaźnikami światowego rozwoju.
bp <- bchain_mkpru
df2 <- bchain_mkpru%>%
mutate(year = format(Date, "%Y")) %>%
group_by(year) %>%
summarise(avgBit= mean(Value)) %>%
transform(year = as.numeric(year))
wdiTmp <- wdi %>%
filter(countryCode =="WLD")%>%
select(year,developmentIndicators, seriesName ,indicator)
factor<- unlist(unique(wdiTmp[c("indicator")]))
experiment <- data.frame(indicator=c(),corelation=c())
for(i in factor){
wdiInd <- wdiTmp%>% filter(indicator ==i) %>%
inner_join(df2,by="year")
corelation <- cor(wdiInd[c("developmentIndicators")],wdiInd[c("avgBit")])
tmp<-data.frame(i,corelation)
colnames(tmp)<-c("indicator","corelation")
rownames(tmp) <- NULL
experiment<- rbind(experiment,tmp)
}
result3_experiment <- experiment %>% filter(corelation>0.9)
result3_experiment$description<-mapply(translateIndicator, result3_experiment$indicator)
prettyTable(result3_experiment %>% select(description, corelation))5 Przewidywanie cen
5.1 Wybór i wizualizacja atrybutów
W tej części skupiono się na przewidywaniu cen złota, ponieważ wartości tego zbiór posiadały większą korelację ze zbiorem kursów walut w porównaniu do cen kryptowaluty. W tym celu wykorzystano poniższe dane
- cen spółek:
- CPI
- Real.Earnings
- Dividend
- wskaźniki światowe:
- GDP (current US$)
- kursy walut:
- Australian.Dollar
- Brunei.Dollar
Ze zbioru wskaźników światowych Wykorzystano wskaźnik GDP (current US$). Jest to wskaźnik ekonomiczny, który można wykorzystać do przewidywania cen złota (źródło).
df_wld <- wdi %>%
filter(countryCode=="WLD" & indicator=="NY.GDP.MKTP.CD") %>%
rename(GPDpc=developmentIndicators)%>%
select(GPDpc, year)
gg <- ggplot(data=df_wld, aes(x=year,y=GPDpc)) +
geom_line()+
ggtitle("GPD")
ggplotly(gg)Poniższy macierz przedstawia korelację wszystkich dostępnych wartości ze zbioru indeksów giełdowych. W celu uniknięcia wykorzystywania nadmiarowej ilości danych nie wykorzystywano atrybutów, które w poniższej macierzy na przecięciu mają korelację równą 1. W związku, z czym wykorzystano tylko: Dividend, CPI oraz Real.Earnings.
tmpdf <- spComposite %>% select(-c(month,year))
corr <- round(cor(tmpdf), 1)
ggcorrplot(corr, type = "lower", lab = TRUE)
Wizualizacja wybranych atrybutów indeksów giełdowych.
df_stonks <- spComposite %>%
select(year, month, Dividend, CPI, Real.Earnings)%>%
mutate(year=as.integer(year), month=as.integer(month))
gg <- ggplot(data=df_stonks, aes(x=year,y=Dividend)) +
geom_line()+
ggtitle("Dividend")
ggplotly(gg)gg <- ggplot(data=df_stonks, aes(x=year,y=CPI)) +
geom_line()+
ggtitle("CPI")
ggplotly(gg)gg <- ggplot(data=df_stonks, aes(x=year,y=Real.Earnings)) +
geom_line()+
ggtitle("Real.Earnings")
ggplotly(gg)Do utworzenia regresora wykorzystano dwie waluty Australian.Dollar oraz Brunei.Dollar. Dolar brunejski został wybrany, ponieważ charakteryzował się największą siłą korelacji. Dolar australijski natomiast również miał bardzo wysoką korelację. Nie wykorzystano natomiast rupii pakistańskich (Pakistani.Rupee) ani korony islandziej (Icelandic.Krona), ponieważ miały one więcej wartości nieustalonych.
df_cur_Australian.Dollar <- cer %>% filter(currency %in% c("Australian.Dollar"))%>%
rename(Australian.Dollar=value) %>% select(Date, Australian.Dollar)
df_cur_Brunei.Dollar <- cer %>% filter(currency %in% c("Brunei.Dollar"))%>%
rename(Brunei.Dollar=value) %>% select(Date, Brunei.Dollar)
df_cur <- merge(df_cur_Australian.Dollar, df_cur_Brunei.Dollar, by="Date")
gg <- ggplot(data=df_cur, aes(Date)) +
geom_line(aes(y = Brunei.Dollar, colour = "Brunei.Dollar"))+
geom_line(aes(y = Australian.Dollar, colour = "Australian.Dollar"))+
ggtitle("Waluty")+
ylab("Value")
ggplotly(gg)W celu uzyskania tylko rekordów, które mają wszystkie dane zdecydowano się na łączenia typu inner join. W poprzednich krokach pozbyto się wartości pustych albo je uzupełniono. W konsekwencji powstały zbiór nie będzie zawierał wartości nieznanych.
df_gold <- gp %>%
select(g_date,g_usd) %>% rename(Date=g_date)
all_ <- df_gold %>% inner_join((df_cur)) %>%
mutate(month =as.integer(format(Date, "%m")), year =as.integer( format(Date, "%Y")))%>%
inner_join(df_stonks, by = c("year" = "year", "month" = "month"))%>%
inner_join(df_wld, by=c("year"="year")) %>%select(-c(year, month))
summary(all_)## Date g_usd Australian.Dollar Brunei.Dollar
## Min. :1998-09-02 Min. : 252.9 Min. :0.4833 Min. :1.000
## 1st Qu.:2003-07-21 1st Qu.: 363.6 1st Qu.:0.6579 1st Qu.:1.347
## Median :2008-05-21 Median : 855.6 Median :0.7633 Median :1.464
## Mean :2008-06-11 Mean : 849.7 Mean :0.7741 Mean :1.507
## 3rd Qu.:2013-05-09 3rd Qu.:1260.0 3rd Qu.:0.8954 3rd Qu.:1.698
## Max. :2018-04-30 Max. :1893.0 Max. :1.1055 Max. :1.850
## Dividend CPI Real.Earnings GPDpc
## Min. :15.69 Min. :163.6 Min. : 8.805 Min. :3.140e+13
## 1st Qu.:16.74 1st Qu.:184.2 1st Qu.: 65.935 1st Qu.:3.895e+13
## Median :24.10 Median :212.2 Median : 89.879 Median :6.044e+13
## Mean :26.71 Mean :208.5 Mean : 84.207 Mean :5.786e+13
## 3rd Qu.:32.88 3rd Qu.:232.9 3rd Qu.:105.320 3rd Qu.:7.523e+13
## Max. :50.33 Max. :250.5 Max. :128.344 Max. :8.634e+13all_together <- all_ %>% select(-c(Date))Sumarycznie powstało 4514 rekordów.
5.2 Tworzenie modelu
Jako model decyzyny wykorzystano Cubist.
set.seed(9)
inTraining <-
createDataPartition(
y = all_together$g_usd,
p = .75,
list = FALSE)
training <- all_together[ inTraining,]
testing <- all_together[-inTraining,]
hist_tmp<-testing %>%
select(g_usd) %>%
mutate(type="testing") %>%
bind_rows(
training %>%
select(g_usd) %>%
mutate(type="training")
)
ggplot(hist_tmp, aes(x=g_usd, fill=type)) +
geom_histogram( color="#ff008c", alpha=0.3, position = 'identity') +
xlab("cena złota")+
ylab("liczba obserwacji")
Na powyższym wykresie możemy zaobserwować, że rozkłady cen złota w zbiorze testowym jak i treningowym są zbliżone.
grid <- expand.grid(committees = c(1, 10, 50, 100), neighbors = c(0, 1, 5, 9))
model <- train(g_usd ~ .,
data = training,
method = "cubist", # ctree>lm
trControl = trainControl(method = "cv"),
tuneGrid = grid)
model## Cubist
##
## 3386 samples
## 6 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 3047, 3047, 3047, 3048, 3048, 3048, ...
## Resampling results across tuning parameters:
##
## committees neighbors RMSE Rsquared MAE
## 1 0 20.74665 0.9980060 12.09673
## 1 1 19.67111 0.9981815 11.20470
## 1 5 19.59974 0.9981964 11.21093
## 1 9 19.76365 0.9981694 11.34545
## 10 0 19.39429 0.9981837 11.25035
## 10 1 18.79193 0.9982724 10.54489
## 10 5 18.74120 0.9982832 10.56549
## 10 9 18.81273 0.9982721 10.64935
## 50 0 18.97917 0.9982693 11.05096
## 50 1 18.42063 0.9983531 10.44076
## 50 5 18.38146 0.9983605 10.45188
## 50 9 18.46057 0.9983476 10.52932
## 100 0 19.35262 0.9981598 11.05591
## 100 1 18.78342 0.9982462 10.43970
## 100 5 18.74537 0.9982530 10.45683
## 100 9 18.82079 0.9982405 10.53351
##
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were committees = 50 and neighbors = 5.5.3 Ewaluacja modelu
predictions <- predict(model, testing)
postResample(pred = predictions, obs = testing$g_usd)## RMSE Rsquared MAE
## 26.3441912 0.9969315 10.9177527tmp<- testing
tmp$pred<-predictions
tmp<-tmp%>%select(g_usd,pred)
head(tmp)## # A tibble: 6 x 2
## g_usd pred
## <dbl> <dbl>
## 1 1321. 1313.
## 2 1348. 1344.
## 3 1347. 1338.
## 4 1344. 1342.
## 5 1337. 1330.
## 6 1346. 1333.Powyższy fragment przedstawia faktyczne wartości oraz przykładowe predykcje.
gbmImp <- varImp(model, scale = FALSE)
plot(gbmImp)
Powyższy wykres przedstawia wagę poszczególnych atrybutów. Okazuje się, że w najmniejszym stopniu do predykcji przyczynił a się wartość światowego PKB, a w największym wartość Divident ze zbioru miesięcznych wyników S&P Composite.